PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/win/pascal/ddeconv.exe/DDECONV.PAS

Pascal/Delphi Source File | 1992-11-26 | 13.7 KB | 486 lines

{************************************************}
{                                                }
{   ddeconv.pas                                  }
{   Turbo Pascal for Windows demo program        }
{   by Klemens Schmid, 100114, 1475              }
{                                                }
{   This program implements a simple DDE         }
{   conversion with any DDE client (Excel,       }
{   WinWord, ProgMan etc.                        }
{                                                }
{************************************************}

program DDEconveration;

uses WinTypes, WinProcs, WObjects, Strings, ShellApi;

{$R DDECONV}

const

{ Resource IDs }

  id_DDEDialog    = 100;

{ DDE dialog item IDs }

  id_Applic      = 100;
  id_Topic       = 101;
  id_Data        = 102;
  id_Result      = 103;
  id_initiate    = 104;
  id_Terminate   = 105;
  id_Request     = 106;
  id_Poke        = 107;
  id_Advise      = 108;
  id_Execute     = 109;
  id_Item        = 110;

{bits in TDDEdata.Flags}
  DDE_fAckReq    = $8000;
  DDE_fDeferUpd = $4000;
  DDE_fRelease   = $2000;
  DDE_fRequested = $1000;
  DDE_fAck       = $0001;

type

  DlgDataDescr= record
     StrApplic,StrTopic,StrItem,StrData,StrResult : array[0..79] of char;
  end;

  PDDEWindow = ^TDDEWindow;
  TDDEWindow = object(TDlgWindow)
    DlgData : DlgDataDescr;
    EditApplic,EditTopic,EditItem,EditData,EditResult : PEdit;
    ServerWindow: HWnd;
    PendingMessage: Word;
    HData : THandle;
    constructor Init;
    procedure SetupWindow; virtual;
    function GetClassName: PChar; virtual;
    procedure cmInitiate(var Msg: TMessage);
      virtual id_First + id_Initiate;
    procedure cmTerminate(var Msg: TMessage);
      virtual id_First + id_Terminate;
    procedure cmRequest(var Msg: TMessage);
      virtual id_First + id_Request;
    procedure cmPoke(var Msg: TMessage);
      virtual id_First + id_Poke;
    procedure cmAdvise(var Msg: TMessage);
      virtual id_First + id_Advise;
    procedure cmExecute(var Msg: TMessage);
      virtual id_First + id_Execute;

    {DDE messages}
    procedure InitiateDDE;
    procedure TerminateDDE;
    procedure PokeDDE(Item:PChar; DataFormat:Word; Data:Pointer; DataSize:Word);
    procedure AdviseDDE(DataFormat:Word; Item:PChar);
    procedure RequestDDE(DataFormat:Word; Item:PChar);
    procedure WMDDEAck(var Msg: TMessage);
      virtual wm_First + wm_DDE_Ack;
    procedure WMDDETerminate(var Msg: TMessage);
      virtual wm_First + wm_DDE_Terminate;
    procedure WMDDEData(var Msg: TMessage);
      virtual wm_First + wm_DDE_Data;
    procedure WMDestroy(var Msg: TMessage);
      virtual wm_First + wm_Destroy;
  end;

{ TDDEApp is the application object. It creates a main window of type
  TDDEWindow. }

  TDDEApp = object(TApplication)
    procedure InitMainWindow; virtual;
  end;

{ TDDEWindow }

{ DDE window constructor. Create all edit x object to represent the
  dialog's list box. Clear the DDE server window handle and the
  pending DDE message ID. }

constructor TDDEWindow.Init;
begin
  TDlgWindow.Init(nil, 'DDE');
  EditApplic:= New(PEdit, InitResource(@Self, id_Applic,80));
  EditTopic := New(PEdit, InitResource(@Self, id_Topic, 80));
  EditItem  := New(PEdit, InitResource(@Self, id_Item, 80));
  EditData  := New(PEdit, InitResource(@Self, id_Data, 80));
  EditResult:= New(PEdit, InitResource(@Self, id_Result, 80));
  ServerWindow := 0;
  PendingMessage := 0;
end;

{ SetupWindow is called right after the DDE window is created.}

procedure TDDEWindow.SetupWindow;
begin
  TDlgWindow.SetupWindow;
  Transferbuffer:=@DlgData;
  EnableTransfer;
end;

{ Return window class name. This name corresponds to the class name
  specified for the DDE dialog in the resource file. }

function TDDEWindow.GetClassName: PChar;
begin
  GetClassName := 'DDEWindow';
end;

{ Is called when the "Initiate" button is pressed}

procedure TDDEWindow.cmInitiate;
begin
  InitiateDDE; { start
end;

{ Is called when the "Terminate" button is pressed}

procedure TDDEWindow.cmTerminate;
begin
  TerminateDDE;
end;

{ Is called when the "Request" button is pressed. Fetch the value
  of the server field denoted by "Item" and display it in field "Data" }

procedure TDDEWindow.cmRequest;
begin
  TransferData(tf_GetData);
  RequestDDE(cf_Text,DlgData.StrItem);
end;

{ Is called when the "Poke" button is pressed. Enter the value
  given in "Data" in the server field denoted by "Item" }

procedure TDDEWindow.cmPoke;
var
   p : integer;
begin
  TransferData(tf_GetData);
  with DlgData do begin
    p:=StrLen(StrData);
    StrData[p]:=#13;
    StrData[p+1]:=#10;
    StrData[p+2]:=#0;
    PokeDDE(StrItem,cf_Text,@StrData,StrLen(StrData)+1);
  end;
end;

{ Is called when the "Advise" button is pressed. Establishes a hot
  link for the field denoted in "Item" }

procedure TDDEWindow.cmAdvise;
begin
  TransferData(tf_GetData);
  AdviseDDE(cf_Text,DlgData.StrItem);
end;

{
procedure TDDEWindow.PokeDDE;
var
   DataRecord:TDDEData;
   lParam:LongInt;
   ItemGlobalAtom : Word;
   PCommands:Pointer;
   Executed : boolean;

begin
   HData :=GlobalAlloc(gmem_Moveable or gmem_DDEshare,
                          SizeOf(TDDEdata) + DataSize);
   Executed := false;
   if (HData <> 0 ) then begin
      PCommands := GlobalLock(HData);
      if PCommands = nil then
         GlobalFree(HData)
      else begin
         DataRecord.cfFormat := DataFormat;
         Move(DataRecord,PCommands^,SizeOf(DataRecord));
         Move(Data^,PDDEdata(PCommands)^.Value,DataSize);
         GlobalUnLock(HData);
         ItemGlobalAtom := GlobalAddAtom(Item);
         lParam := ItemGlobalAtom;
         lParam := (lParam shl 16) or HData;
         if PostMessage(ServerWindow, wm_DDE_Poke, HWIndow,lParam) then begin
            PendingMessage := wm_DDE_Poke;
            Executed := True;
            end
         else begin
            GlobalFree(HData);
            GlobalDeleteAtom(ItemGlobalAtom);
         end;
      end
   end;
   if not Executed then
     MessageBox(HWindow, 'DDE execute failed.',
       'Error', mb_IconExclamation or mb_Ok);
end;


procedure TDDEWindow.RequestDDE;
var
   lParam:LongInt;
   ItemGlobalAtom : Word;
   Executed : boolean;

begin
   Executed := false;
   ItemGlobalAtom := GlobalAddAtom(Item);
   lParam := ItemGlobalAtom;
   lParam := (lParam shl 16) or DataFormat;
   if PostMessage(ServerWindow, wm_DDE_Request, HWIndow,lParam) then begin
      PendingMessage := wm_DDE_Request;
      Executed := True;
      end
   else begin
      GlobalDeleteAtom(ItemGlobalAtom);
   end;
   if not Executed then
     MessageBox(HWindow, 'DDE request failed.',
       'Error', mb_IconExclamation or mb_Ok);
end;


procedure TDDEWindow.AdviseDDE;
var
   lParam:LongInt;
   ItemGlobalAtom : Word;
   Executed  : boolean;
   PCommands : PDDEdata;

begin
   Executed := false;
   ItemGlobalAtom := GlobalAddAtom(Item);
   HData := GlobalAlloc(gmem_Moveable or gmem_DDEshare,sizeof(TDDEdata));
   if HData <> 0 then begin
     PCommands := GlobalLock(HData);
     if PCommands = nil then
        GlobalFree(HData)
     else begin
        PCommands^.cfFormat := DataFormat;
        PCommands^.Flags := 0; {DDE_FAckReq or DDE_FDeferUpd;}
        GlobalUnLock(HData);
        lParam := ItemGlobalAtom;
        lParam := (lParam shl 16) or HData;
        if PostMessage(ServerWindow, wm_DDE_Advise, HWIndow,lParam) then begin
           PendingMessage := wm_DDE_Advise;
           Executed := True;
           end
        else begin
           GlobalDeleteAtom(ItemGlobalAtom);
           GlobalFree(HData);
        end;
     end;
   end; {if HData}
   if not Executed then
     MessageBox(HWindow, 'DDE advise failed (1)',
       'Error', mb_IconExclamation or mb_Ok);
end;


{ Initiate a DDE conversation with a server application. Application
  name and topic name is taken from corresponding Edit fields. Note
  than SendMessage is used here in contradiction to other cases.
  If server application isn't up it is started via ShellExecute. }

procedure TDDEWindow.InitiateDDE;
var
  AppAtom, TopicAtom: TAtom;
begin
  TransferData(tf_GetData);
  PendingMessage := wm_DDE_Initiate;
  AppAtom := GlobalAddAtom(DlgData.StrApplic);
  TopicAtom := GlobalAddAtom(DlgData.StrTopic);
  if GetModuleHandle(DlgData.StrApplic) = 0 then  {application no active}
     ShellExecute(HWindow,nil,DlgData.StrApplic,DlgData.StrTopic,nil,sw_Show);
  SendMessage(HWnd(-1), wm_DDE_Initiate, HWindow,
    MakeLong(AppAtom, TopicAtom));
  GlobalDeleteAtom(AppAtom);
  GlobalDeleteAtom(TopicAtom);
  PendingMessage := 0;
  if ServerWindow = 0 then
    MessageBox(HWindow, 'Cannot establish DDE link',
      'Error', mb_IconExclamation or mb_Ok);
end;

{ Terminate the DDE conversation. Send the wm_DDE_Terminate message
  only if the server window still exists. }

procedure TDDEWindow.TerminateDDE;
var
  W: HWnd;
begin
  W := ServerWindow;
  ServerWindow := 0;
  if IsWindow(W) then PostMessage(W, wm_DDE_Terminate, HWindow, 0);
end;

{ trigger DDE server application to execute the command provided
  in the Edit field "Data". Only makes sense for commands under-
  standable by the server. }

procedure TDDEWindow.cmExecute(var Msg: TMessage);
var
  Executed: Boolean;
  I, L: Integer;
  PName, PCommands: PChar;
  Name: array[0..63] of Char;
begin
  TransferData(tf_GetData);
  Executed := False;
  if (ServerWindow <> 0) and (PendingMessage = 0) then
  begin
    L := StrLen(DlgData.StrData) +1;
    HData := GlobalAlloc(gmem_Moveable or gmem_DDEShare, L);
    if HData <> 0 then
    begin
      PCommands := GlobalLock(HData);
      StrCopy(PCommands,DlgData.StrData);
      GlobalUnlock(HData);
      if PostMessage(ServerWindow, wm_DDE_Execute, HWindow,
        MakeLong(0, HData)) then
      begin
        PendingMessage := wm_DDE_Execute;
        Executed := True;
      end else GlobalFree(HData);
    end;
  end;
  if not Executed then
    MessageBox(HWindow, 'DDE execute failed.',
      'Error', mb_IconExclamation or mb_Ok);
end;

{ wm_DDE_Ack message response method is called of the server answers
  to one of our messages Initiate, Terminate, Request, Advise,
  Execute or Poke. Aside from other things it frees the handles
  sent by the server. }

procedure TDDEWindow.WMDDEAck(var Msg: TMessage);
begin
  case PendingMessage of
    wm_DDE_Initiate:
      begin
        if ServerWindow = 0 then begin
          ServerWindow := Msg.WParam;
          GlobalGetAtomName(Msg.lParamLo,DlgData.StrResult,79);
          TransferData(tf_SetData);
          Show(sw_Show);
          end
        else
          PostMessage(Msg.WParam, wm_DDE_Terminate, HWindow, 0);
        GlobalDeleteAtom(Msg.LParamLo);
        GlobalDeleteAtom(Msg.LParamHi);
      end;
    wm_DDE_Execute:
      begin
        GlobalFree(Msg.LParamHi);
      if Msg.lParamLo = 0 then {negative ackn}
         GlobalFree(HData)
      else
         GlobalFree(Msg.LParamHi);
        PendingMessage := 0;
        SetFocus(HWindow);
      end;
    wm_DDE_Poke:
      begin
        GlobalFree(Msg.LParamHi);
      if Msg.lParamLo = 0 then {negative ackn}
         GlobalFree(HData)
      else
         GlobalFree(Msg.LParamHi);
        PendingMessage := 0;
        SetFocus(HWindow);
      end;
    wm_DDE_Request:
      begin
      GlobalDeleteAtom(Msg.LParamHi);
      MessageBox(HWindow, 'DDE data not received',
        'Error', mb_IconExclamation or mb_Ok);
      end;
    wm_DDE_Advise:
      begin
      GlobalDeleteAtom(Msg.LParamHi);
      if Msg.lParamLo = 0 then begin {negative ackn}
         GlobalFree(HData);
         MessageBox(HWindow, 'DDE advise failed (2)',
           'Error', mb_IconExclamation or mb_Ok);
         end
      else
         GlobalFree(Msg.LParamLo);
      end;
  end;
end;

{ This procedure is triggered if the server send a data value either
  in response to a DDE "Request" or "Advise" if the value of the
  hot linked data item has changed }

procedure TDDEWindow.WMDDEData(var Msg: TMessage);
var
   p:PDDEData;
   lParam : longint;
   DataRecord : TDDEdata;
begin
   GlobalGetAtomName(Msg.lParamHi,DlgData.StrItem,79);
   p:=GlobalLock(Msg.lParamLo);  {ptr to DDEdata}
   if p = nil then begin {we have to request}
      GlobalFree(Msg.lParamLo);
      GLobalDeleteAtom(Msg.lParamHi);
      RequestDDE(cf_Text,DlgData.StrItem);
      exit;
   end;
   Move(P^,DataRecord,Sizeof(DataRecord));
   StrCopy(@DlgData.StrResult,@P^.Value);
   GlobalUnlock(Msg.lParamLo);
   if (DataRecord.Flags or DDE_fRelease) <> 0 then
      GlobalFree(Msg.lParamLo);
   if (DataRecord.Flags or DDE_fAckReq) <> 0 then begin
      lParam:=DDE_FAckReq or (Msg.lParamHi shl 16);
      if not PostMessage(ServerWindow,wm_DDE_Ack,HWindow,lParam)  then
         GLobalDeleteAtom(Msg.lParamHi); {use the old atom}
   end;
   TransferData(tf_SetData);
   Show(sw_Show);
end;

{ wm_DDE_Terminate message response method. If the window signaling
  termination is our server window, terminate
  the DDE conversation. Otherwise ignore the wm_DDE_Terminate. }

procedure TDDEWindow.WMDDETerminate(var Msg: TMessage);
begin
  if Msg.WParam = ServerWindow then TerminateDDE;
end;


{ wm_Destroy message response method. Terminate the DDE link and
  call the inherited WMDestroy. }

procedure TDDEWindow.WMDestroy(var Msg: TMessage);
begin
  TerminateDDE;
  TDlgWindow.WMDestroy(Msg);
end;


{ TDDEApp }

{ Create a DDE window as the application's main window. }

procedure TDDEApp.InitMainWindow;
begin
  MainWindow := New(PDDEWindow, Init);
end;

var
  DDEApp: TDDEApp;

begin
  DDEApp.Init('DDEconv');
  DDEApp.Run;
  DDEApp.Done;
end.